home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / stataMode.tcl < prev    next >
Encoding:
Text File  |  2001-01-26  |  69.7 KB  |  2,044 lines
  1. ## -*-Tcl-*-  (nowrap)
  2.  # ==========================================================================
  3.  #  Statistical Modes - an extension package for Alpha
  4.  # 
  5.  #  FILE: "stataMode.tcl"
  6.  #                                    created: 01/15/00 {07:15:32 pm} 
  7.  #                                last update: 01/26/01 {12:08:23 pm} 
  8.  #  Description: 
  9.  # 
  10.  #  For Stata "do" and output files.
  11.  #  
  12.  #  Author: Craig Barton Upright
  13.  #  E-mail: <cupright@princeton.edu>
  14.  #    mail: Princeton University,  Department of Sociology
  15.  #          Princeton, New Jersey  08544
  16.  #     www: <http://www.princeton.edu/~cupright>
  17.  #  
  18.  #  Stata menu written, maintained by L. Phillip Schumm <pschumm@uchicago.edu> 
  19.  #  
  20.  # -------------------------------------------------------------------
  21.  #  
  22.  # Copyright (c) 2000-2001  Craig Barton Upright, L. Phillip Schumm
  23.  # 
  24.  # This program is free software; you can redistribute it and/or modify
  25.  # it under the terms of the GNU General Public License as published by
  26.  # the Free Software Foundation; either version 2 of the License, or
  27.  # (at your option) any later version.
  28.  # 
  29.  # This program is distributed in the hope that it will be useful,
  30.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  31.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  32.  # GNU General Public License for more details.
  33.  # 
  34.  # You should have received a copy of the GNU General Public License
  35.  # along with this program; if not, write to the Free Software
  36.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  37.  # 
  38.  # ==========================================================================
  39.  ##
  40.  
  41. # ===========================================================================
  42. # 
  43. # ◊◊◊◊ Initialization of Stta mode ◊◊◊◊ #
  44. # 
  45.  
  46. alpha::mode Stta 2.1.1 stataMenu {*.do *.ado} {
  47.     stataMenu electricReturn electricSemicolon electricTab electricBraces
  48. } {
  49.     # We require 7.4b21 for prefs handling.
  50.     alpha::package require -loose AlphaTcl 7.4b21
  51.     addMenu stataMenu "•155" Stta
  52.     set unixMode(stata) {Stta}
  53.     set modeCreator(S5x8) {Stta}
  54. } uninstall {
  55.     catch {file delete [file join $HOME Tcl Modes stataMode.tcl]}
  56.     catch {file delete [file join $HOME Tcl Completions SttaCompletions.tcl]}
  57.     catch {file delete [file join $HOME Tcl Completions "Stta Tutorial.do"]}
  58. } help {
  59.     file "Statistical Modes Help"
  60. } maintainer {
  61.     "Craig Barton Upright" <cupright@princeton.edu> 
  62.     <http://www.princeton.edu/~cupright/>
  63. }
  64.  
  65. hook::register quitHook Stta::quitHook
  66.  
  67. proc stataMenu {} {}
  68.  
  69. proc stataMode.tcl {} {}
  70.  
  71. namespace eval Stta {}
  72.  
  73. # ===========================================================================
  74. # 
  75. # ◊◊◊◊  Stta mode variables ◊◊◊◊ #
  76. #
  77.  
  78. # Removing obsolete preferences from earlier versions.
  79.  
  80. set oldvars {
  81.     abbrevColor addAbbreviations addArguments addFunctions addMacros
  82.     addModifiers addParameters argumentColor codebookSuffix datedColor
  83.     delimiter don'tRemindMe electricTab functionColor keywordColor
  84.     localHelpOnly parameterColor macroColor modifierColor stataHelp
  85. }
  86.  
  87. foreach oldvar $oldvars {prefs::removeObsolete SttamodeVars($oldvar)}
  88.  
  89. unset oldvar oldvars
  90.  
  91. # ===========================================================================
  92. #
  93. # Standard preferences recognized by various Alpha procs
  94. #
  95.  
  96. newPref var  fillColumn         {75}                    Stta
  97. newPref var  leftFillColumn     {0}                     Stta
  98. newPref var  prefixString       {* }                    Stta
  99. newPref var  wordBreak          {[-a-zA-Z0-9\._\#]+}    Stta
  100. newPref var  wordBreakPreface   {[^-a-zA-Z0-9\._\#]}    Stta
  101. newPref flag wordWrap           {0}                     Stta
  102.  
  103. # ===========================================================================
  104. #
  105. # Flag preferences
  106. #
  107.  
  108. newPref flag autoMark           {0}     Stta    {Stta::rebuildMenu markStataFileAs}
  109.  
  110. # Indent all continued commands, indicated by "/*" at the end of a command
  111. # line, or by the lack of a semi-colon if the "Semi Delimiter" preference
  112. # is set, by the full indentation amount rather than half.
  113. newPref flag fullIndent         {1}     Stta    {Stta::rebuildMenu markStataFileAs}
  114.  
  115. # Check this box if to use semicolons as a delimiter in do files.  This
  116. # will be used in all electric completions.
  117. newPref flag semiDelimiter      {0}     Stta    {Stta::rebuildMenu stataHelp}
  118.  
  119. # By default command double-click will send a command to on-line help, and
  120. # option double-click sends a command to the local Stata application. 
  121. # Check this box to switch these key combinations.
  122. newPref flag localHelp          {0}     Stta    {Stta::rebuildMenu stataHelp}
  123.  
  124. # Check this box if your keyboard does not have a "Help" key.  This will
  125. # change some of the menu's key bindings.
  126. newPref flag noHelpKey          {0}     Stta    {Stta::rebuildMenu stataHelp}
  127.  
  128. # Set the list of flag preferences which can be changed in the menu.
  129.  
  130. set SttaPrefsInMenu [list       \
  131.   "localHelp"                   \
  132.   "noHelpKey"                   \
  133.   "semiDelimiter"               \
  134.   "fullIndent"                  \
  135.   ]
  136.  
  137. # ===========================================================================
  138. #
  139. # Variable preferences
  140. # 
  141.  
  142. # Enter additional Stata commands  or abbreviations to be colorized.
  143. newPref var addCommands         {}      Stta    {Stta::colorizeStta}
  144.  
  145. # Enter additional options or abbreviations to be colorized.  
  146. newPref var addOptions          {gen rep}       Stta    {Stta::colorizeStta}
  147.  
  148. # Command double-clicking on a Stata keyword will send it to this url for a
  149. # help reference page.
  150. newPref url helpUrl             {http://www.stata.com/help.cgi?}        Stta
  151.  
  152. # The "Stata Home Page" menu item will send this url to your browser.
  153. newPref url stataHomePage       {http://www.stata.com/} Stta
  154.  
  155. # Click on "Set" to find the local Stata application.
  156. newPref sig stataSig            {S5x8}  Stta
  157.  
  158. # ===========================================================================
  159. # 
  160. # Color preferences
  161. #
  162. # Nomenclature notes:
  163. # 
  164. # Stata has five levels of processes.
  165. # 
  166. #   1. "commands", "subcommands", "prefixes":  describe, define, quietly, 
  167. #   2. "parameters": textsize, maxobs, prefix, more,
  168. #   3. "functions": abs(), log(), sin(), ge, lt,
  169. #   4. "options": saving(), naxis graph, matrix graph,
  170. #   5. "modifiers": [weights= ], [frequency= ]
  171. # 
  172. #  and, just to help make sure that everything goes smoothly, we have
  173. #  
  174. #   6. out of date (or "dated") commands:  genrank, grebar
  175. #   
  176. # For the most part, Stata is very good about not using the same name for a
  177. # command to refer to a function, parameter, or modifier.  Options,
  178. # however, often have the same names as commands.
  179. # 
  180. # The default setup of this mode is to colorize all of commands,
  181. # subcommands, prefixes, parameters, and macros blue.  Options, functions,
  182. # modifiers, and symbols are colorized magenta.  Dated commands are red. 
  183. # The user does not have to specify all of these different levels -- only
  184. # Command, Comment, Option, String, and Symbol colors appear in the
  185. # preferences.
  186. # 
  187. # In addition, non-ambiguous abbreviations of command names are allowed. 
  188. # They could be entered as Additional Commands or Additional Options
  189. # through Config -- > Mode --> Mode Preferences.
  190. # 
  191. # The sections which follow are based on release 3.1 of Stata, because that
  192. # was the latest full manual that I could get my hands on ...
  193. #
  194.  
  195. # See the Statistical Modes Help file for an explanation of these different
  196. # categories, and lists of keywords.
  197. newPref color commandColor      {blue}      Stta    {Stta::colorizeStta}
  198. newPref color commentColor      {red}       Stta    {stringColorProc}
  199. newPref color optionColor       {magenta}   Stta    {Stta::colorizeStta}
  200. newPref color stringColor       {green}     Stta    {stringColorProc}
  201.  
  202. # The color of symbols such as "+", "-", etc.
  203. newPref color symbolColor       {magenta}   Stta    {Stta::colorizeStta}
  204.  
  205. regModeKeywords -e {*} -b {/*} {*/}     \
  206.   -c $SttamodeVars(commentColor)        \
  207.   -s $SttamodeVars(stringColor) Stta {}
  208.  
  209. # ==========================================================================
  210. # 
  211. # Comment Character variables for Comment Line / Paragraph / Box menu items.
  212. # 
  213.  
  214. set Stta::commentCharacters(General)    "* "
  215. set Stta::commentCharacters(Paragraph)  [list "/* " " */" " * "]
  216. set Stta::commentCharacters(Box)        [list "/*" 2 "*/" 2 "*" 3]
  217.  
  218. # The Comment Line command is hard-wired -- except for the C and C++ modes,
  219. # if the commentCharacters(Paragraph) are different, then Comment Line will
  220. # automatically be bracketed.  Thus I am simply redefining the command-d
  221. # key-binding to ignore commentLine
  222.  
  223. Bind 'd' <c>  {insertPrefix} Stta
  224.  
  225. # ===========================================================================
  226. # 
  227. # Flag Flip
  228. # 
  229. # Called by menu items, change the value of flag preferences.
  230. # 
  231.  
  232. proc Stta::flagFlip {pref} {
  233.  
  234.     global mode SttamodeVars
  235.  
  236.     set SttamodeVars($pref) [expr {$SttamodeVars($pref) ? 0 : 1}]
  237.     set oldMode $mode
  238.     set mode "Stta"
  239.     synchroniseModeVar $pref $SttamodeVars($pref)
  240.     set mode $oldMode
  241.     if {$SttamodeVars($pref)} {
  242.         set end "on"
  243.     } else {
  244.         set end "off"        
  245.     } 
  246.     message "The \"$pref\" preference is now $end."
  247. }
  248.  
  249. # ===========================================================================
  250. # 
  251. # ◊◊◊◊ Keyword Dictionaries ◊◊◊◊ #
  252. #
  253.  
  254. # Making sure that SttaUserCommands and SttaUserOptions exist.
  255. # These will be over-ridden if they are loaded from a ${mode}Prefs.tcl file.
  256. #
  257.  
  258. set SttaUserCommands    ""
  259. set SttaUserOptions     ""
  260.  
  261. # ===========================================================================
  262. # 
  263. # ◊◊◊◊   Stta Commands   ◊◊◊◊ #
  264. #
  265. # this also includes a select few unix shell commands
  266. #
  267.  
  268. set SttaCommands { 
  269.     STATA _qreg _robust accum acprplot adopath alpha anova aorder append
  270.     areg assert auto.dta avplot avplots bcskew0 begin bitest bitesti blogit
  271.     bmemsize boxcox bprobit brier bs bsample bsqreg bstat bstrap canon cc
  272.     cchart cci cd centile cf ci cii clear clogit cmdtool cnreg cnsreg
  273.     codebook coleq collapse colnames compare compress confirm constraint
  274.     convert correlate count cox cprplot cross cs csi cumul cusum decode
  275.     define degph delimit depnames describe dfbeta dictionary dir discard
  276.     dispCns display do dprobit drop ds dydx echo egen eivreg else encode
  277.     end erase ereg error existence exit expand factor fillin for format fsl
  278.     function generate gladder global glogit glsaccum gnbreg gphdot gphpen
  279.     gprobit graph greigen grmeanby groups gunzip gzip hadimvo heckman help
  280.     hilite hold hotel if impute infile input inspect integ intreg ipolate
  281.     iqreg ir iri kap kappa kapwgt keep ksm ksmirnov ktau kwallis ladder
  282.     lfit linktest list lnskew0 local log logistic logit loneway lookfor
  283.     lroc lrtest ls lstat ltable lv lvr2plot makeCns man matcproc maximize
  284.     mcc mcci means memsize menu merge method mhodds mlogit mlout model move
  285.     mvdecode mvencode mvreg mx_param nbreg nl nlinit nptrend ologit oprobit
  286.     order outfile outsheet pause pchart pchi pcorr pd pd.X pd.ix pd.sunview
  287.     pd.wy99 plot pnorm poisson post postclose postfile predict preserve
  288.     probit profile.do pwcorr pwd qchi qnorm qqplot qreg quantile query
  289.     range ranksum rchart recast recode regph regress rename renpfix replace
  290.     report restore review rm rotate roweq rownames rreg run runtest rvfplot
  291.     rvpplot sample save score sdtest sdtesti search serrbar sfrancia shell
  292.     shewhart signrank signtest sktest smooth sort spearman sqreg stack stem
  293.     substitute summarize sureg svd swilk symeigen symplot sysdir tab1 tab2
  294.     tabi tabodds tabulate tempfile tempname tempvar testparm tobit touch
  295.     ttest ttesti type uncompress unhold use vars vecaccum verinst version
  296.     weibull which while window xchart xpose
  297. }
  298.  
  299. # ===========================================================================
  300. # 
  301. # ◊◊◊◊   Prefixes   ◊◊◊◊ #
  302.  
  303. # This includes not only prefixes proper {capture, noisily, quietly}, but
  304. # also commands that are only part of command-phrases.  These are
  305. # distinguished from SttaCommands for the Stta::Completions::Commands proc.
  306. #
  307.  
  308. set SttaPrefixes {
  309.     capture constraint eq estimates label macro matrix ml noisily program
  310.     quietly reshape scalar set window xi:
  311. }
  312.  
  313. # ===========================================================================
  314. # 
  315. # ◊◊◊◊   Parameters   ◊◊◊◊ #
  316. #
  317.  
  318. set SttaParameters {
  319.     adosize ANSI beep contents graphics IBM level linesize matsize maxobs
  320.     maxvar memory more obs output pagesize prefix rmsg seed textsize trace
  321.     video virtual width
  322. }
  323.  
  324. # ===========================================================================
  325. # 
  326. # ◊◊◊◊   Functions   ◊◊◊◊ #
  327. #
  328.  
  329. set SttaFunctions {
  330.     abs atan autocode Binomial chiprob comma condcos diff exp float fprob
  331.     gammap ge get group gt ibeta index int invbimonial invnorm invt iqr le
  332.     length ln lngamma lower lt ltrim ma max mean median mod min norprob
  333.     pctile rawsum real rank round rmean rmiss robs rtrim rsum sd sign sin
  334.     sqrt string std substr sum thru tprob trim uniform upper
  335. }
  336.  
  337. # ===========================================================================
  338. # 
  339. # ◊◊◊◊   Options  ◊◊◊◊ #
  340. #
  341.  
  342. set SttaOptions {
  343.     ..  Rescale V accumulate accuracy adjust all alt asif b1title b2title
  344.     backward bands bar bartlett basecategory beta bin bonferroni border box
  345.     bsize bwidth cell censored chi2 column connect constraints continuity
  346.     cooksd corr covariance cutoff ddeviance dead delta density depname depv
  347.     detail deviance df dof dx2 eform eps equal equation exact exposure
  348.     factors failure fcnlabel fenter forward from fstay gamma gap genwt get
  349.     group half hascons hat hazard histogram hlines horst hr i incr init
  350.     initial intervals ipf irr iterate jitter l1title l2title leave lf0
  351.     limits line lines lnlsq lnnormal lock lower lowess lrchi2 ltolerance
  352.     margin mineigen missing mse1 noadjust noalt noanova noauto noaxis
  353.     noborder nocoef nocone noconf nocons noconstant nodetail noformat
  354.     nofreq nograph noheader nolabel nolog nomeans noobs norotate nostandard
  355.     notab notable notest noties noweight number oneway or outcome pc pcd pe
  356.     pen pie pr pr2 promax protect psize r1title r2title random rbox reps
  357.     rescale resid residuals rlabel rlog root rrr rscale rstandard rstudent
  358.     rtick rules scheffe select shading sidak split stabilzied star stdf
  359.     stdp stdr strata symbol symbolic t1title t2title taub threshold title
  360.     tlabel tolerance total tr trim ttick tune tvid twoway unequal unpaired
  361.     upper varimax varp vlines vwidth wgt wide wlsiter wrap xb xlabel xlog
  362.     xscale xtick ylabel ylog yscale ytick zero
  363. }
  364.     
  365.  
  366. # ===========================================================================
  367. # 
  368. # ◊◊◊◊   Modifiers   ◊◊◊◊ #
  369. #
  370.  
  371. set SttaModifiers {
  372.     .do .dot .dta .gph .help .log .pen .raw .xp TEMP _N _all _b _coef
  373.     _merge _n _pi _rc _se aweight by fast frequency fweight in iweight
  374.     ltolerance off old on pddefs pweight saving stata.do stata.hlp
  375.     stata.lic stata.mnu stata.usr statpd title using value values variable
  376.     variables weight
  377. }
  378.  
  379. # ===========================================================================
  380. # 
  381. # ◊◊◊◊   Stata Macros   ◊◊◊◊ #
  382. #
  383.  
  384. set SttaMacros {
  385.     S_ADO A_DATE S_E_ S_E_11 S_mdf S_nobs S_E_tdf S_FLAVOR S_FN
  386.     S_MACHID S_mldbug S_MODE S_NOFKEY S_OS S_OSDTL S_TIME
  387. }
  388.  
  389. # ===========================================================================
  390. # 
  391. # ◊◊◊◊   Dated Commands   ◊◊◊◊ #
  392. #
  393.  
  394. set SttaDated {
  395.     _huber boot bootsamp chdir clogitp corc coxbase coxhaz coxvar datetof
  396.     dbeta deff disp_res disp_s etodow etof etomdy fit fpredict ftodate ftoe
  397.     ftomdy ftowdate genrank genstd genvmean glmpred grebar gwood hareg
  398.     hereg hlogit hlu hprobit hreg huber kapmeier leverage logiodds
  399.     logiodds2 loglogs logrank lpredict mantel mdytoe mdytof modify nlpred
  400.     ologitp oprobitp parse regdw remap repeat stepwise survcurv survival
  401.     survsum swcnreg swcox swereg swlogis swlogit swologit swoprbt swpois
  402.     swprobit swqreg swtobit swweib textstd wdatetof wilcoxon xtpred
  403. }
  404.  
  405. #==============================================================================# 
  406. # 
  407. # Colorize Stta
  408. # 
  409. # Set all keyword lists, and colorize.
  410. # 
  411. # Could also be called in a <mode>Prefs.tcl file
  412. # 
  413.  
  414. proc Stta::colorizeStta {{pref ""}} {
  415.     
  416.     global SttamodeVars  SttaCommands SttaPrefixes     SttaParameters  
  417.     global SttaFunctions SttaOptions  SttaModifiers    SttaMacros         
  418.     global SttaDated     SttaUserCommands SttaUserOptions
  419.     
  420.     global SttaCommandList SttaOptionList Sttacmds
  421.  
  422.     # First setting aside only the commands, for Stta::Completion::Command.
  423.     set SttaCommandList [concat                                 \
  424.       $SttaCommands $SttaPrefixes $SttamodeVars(addCommands)    \
  425.       $SttaUserCommands $SttaParameters                         \
  426.       ]
  427.  
  428.     # Then setting aside only the options, for Sttaelectric().
  429.     set SttaOptionList [concat                                  \
  430.       $SttaOptions $SttamodeVars(addOptions) $SttaUserOptions   \
  431.       ]
  432.  
  433.     # Then, create the list of all keywords for completions.
  434.     set Sttacmds [lsort [concat                                 \
  435.       $SttaCommandList $SttaOptionList $SttaFunctions           \
  436.       $SttaModifiers $SttaDated                                 \
  437.       ]]
  438.  
  439.     # Commands, Prefixes, Parameters, User Macros
  440.     regModeKeywords -a                          \
  441.       -k $SttamodeVars(commandColor) Stta $SttaCommandList
  442.     
  443.     # Functions, Options, Modifiers, Stata-Macros, 
  444.     regModeKeywords -a                          \
  445.       -k $SttamodeVars(optionColor) Stta        \
  446.       [concat $SttaOptionList $SttaFunctions    \
  447.       $SttaParameters $SttaModifiers $SttaMacros ]
  448.     
  449.     # Dated
  450.     regModeKeywords -a                          \
  451.       -k red Stta $SttaDated 
  452.     
  453.     # Symbols
  454.     regModeKeywords -a                          \
  455.       -k $SttamodeVars(symbolColor) Stta {|}    \
  456.       -i "+" -i "-" -i "_" -i "\\"              \
  457.       -I $SttamodeVars(symbolColor) 
  458.     
  459.     if {$pref != ""} {refresh}
  460. }
  461.  
  462. # Call this now.
  463.  
  464. Stta::colorizeStta
  465.  
  466. # ===========================================================================
  467. #
  468. # Reload Completions.  
  469. # 
  470. # This is now an obsolete proc.
  471. # 
  472.  
  473. proc Stta::reloadCompletions {} {
  474.     alertnote "\"Stta::reloadCompletions\" is an obsolete proc.\
  475.       It should be removed from your SttaPrefs.tcl file."
  476. }
  477.  
  478. # ===========================================================================
  479. #
  480. # ◊◊◊◊ Key Bindings, Electrics ◊◊◊◊ #
  481. # 
  482. # abbreviations:  <o> = option, <z> = control, <s> = shift, <c> = command
  483. # 
  484.  
  485. # Known bug: Key-bindings from other global menus might conflict with those
  486. # defined in the Stata menu.  This will help ensure that this doesn't happen.
  487.  
  488. Bind 's'    <cs>    {Stta::switchToStata} Stta
  489. Bind 'd'    <cs>    {Stta::doFile} Stta
  490. Bind 'd'    <csz>   {Stta::doSelection} Stta
  491. Bind 'p'    <cs>    {Stta::insertPath} Stta
  492. Bind 'p'    <csz>   {Stta::programTamplate} Stta
  493.  
  494. Bind '\;'   <sz>    {Stta::helpProc stataHelp semiDelimiter} Stta
  495. Bind ':'    <sz>    {Stta::helpProc stataHelp semiDelimiter} Stta
  496.  
  497. Bind 'n'    <sz>    {Stta::nextCommand} Stta
  498. Bind 'p'    <sz>    {Stta::prevCommand} Stta
  499. Bind 's'    <sz>    {Stta::selectCommand} Stta
  500. Bind 'c'    <sz>    {Stta::copyCommand} Stta
  501.  
  502. Bind 'i'    <cz>    {Stta::reformatCommand} Stta
  503.  
  504. Bind '\r'   <s>     {Stta::continueCommand} Stta
  505. Bind '\)'           {Stta::electricRight "\)"} Stta
  506.  
  507. # For those that would rather use arrow keys to navigate.  Up and down
  508. # arrow keys will advance to next/prev command, right and left will also
  509. # set the cursor to the top of the window.
  510.  
  511. Bind    up  <sz>    {Stta::prevCommand 0 0} Stta
  512. Bind  left  <sz>    {Stta::prevCommand 0 1} Stta
  513. Bind  down  <sz>    {Stta::nextCommand 0 0} Stta
  514. Bind right  <sz>    {Stta::nextCommand 0 1} Stta
  515.  
  516. # ===========================================================================
  517. # 
  518. # Stta Carriage Return
  519. # 
  520. # Inserts a carriage return, and indents properly.
  521. # 
  522.  
  523. proc Stta::carriageReturn {} {
  524.     
  525.     global SttamodeVars
  526.     
  527.     if {[isSelection]} {deleteSelection} 
  528.     
  529.     set pos1 [lineStart [getPos]]
  530.     set pos2 [getPos]
  531.     if {[regexp {^([\t ])*(end|\}|\))} [getText $pos1 $pos2]]} {
  532.         createTMark temp $pos2
  533.         catch {bind::IndentLine}
  534.         gotoTMark temp ; removeTMark temp
  535.     } 
  536.     insertText "\r"
  537.     catch {bind::IndentLine}
  538. }
  539.  
  540. # ===========================================================================
  541. # 
  542. # Stta Electric Semi
  543. # 
  544. # Inserts a semi, carriage return, and indents properly.
  545. # 
  546.  
  547. proc Stta::electricSemi {} {
  548.     
  549.     global SttamodeVars 
  550.     
  551.     if {[isSelection]} {
  552.         deleteSelection
  553.     } 
  554.     if {[literalChar] || !$SttamodeVars(semiDelimiter)} {
  555.         typeText {;}
  556.         return
  557.     }
  558.     set pos1 [lineStart [getPos]]
  559.     set pos2 [getPos]
  560.     insertText {;}
  561.     bind::CarriageReturn
  562. }
  563.  
  564. # ===========================================================================
  565. #
  566. # Stta Electric Left, Right
  567. # 
  568. # Adapted from "tclMode.tcl"
  569. # 
  570.  
  571. proc Stta::electricLeft {} {
  572.  
  573.     if {[literalChar]} {
  574.         typeText "\{"
  575.         return
  576.     }
  577.     set pat "\}\[ \t\r\n\]*(else(if)?)\[ \t\r\n\]*\$"
  578.     set pos [getPos]
  579.     if { [set result [findPatJustBefore "\}" $pat $pos word]] == "" } { 
  580.         insertText "\{"
  581.         return
  582.     }
  583.     # we have an if/else(if)/else
  584.     switch -- $word {
  585.         "else" {
  586.             deleteText [lindex $result 0] $pos
  587.             elec::Insertion "\} $word \{\r\t••\r\}\r••"
  588.         }
  589.         "elseif" {
  590.             deleteText [lindex $result 0] $pos
  591.             elec::Insertion "\} $word \{••\} \{\r\t••\r\}\r••"
  592.         }
  593.     }
  594. }
  595.     
  596. proc Stta::electricRight {{char "\}"}} {
  597.     
  598.     if {[literalChar]} {
  599.         typeText $char
  600.         return
  601.     }
  602.     set pos [getPos]
  603.     typeText $char
  604.     if {![regexp {[^ \t]} [getText [lineStart $pos] $pos]]} {
  605.         set pos [lineStart $pos]
  606.         createTMark temp [getPos]
  607.         catch {bind::IndentLine}
  608.         gotoTMark temp ; removeTMark temp
  609.         bind::CarriageReturn
  610.     } 
  611.     if {[catch {blink [matchIt $char [pos::math $pos - 1]]}]} {
  612.         beep ; message "No matching $char !!"
  613.     } 
  614. }
  615.  
  616. # ===========================================================================
  617. #
  618. # Continue Command
  619. # 
  620. # Indenting continuation lines relative to start of command.
  621. # 
  622.  
  623. proc Stta::continueCommand {} {
  624.  
  625.     set thisLine [lindex [Stta::getCommandLine [lineStart [getPos]] 1 0] 2]
  626.     set thisLine [string trim $thisLine]
  627.     if {![regexp {/\*([^\*]*)$} $thisLine]} {
  628.         typeText " /*"
  629.     } 
  630.     Stta::carriageReturn
  631.     insertText "*/ "
  632. }
  633.  
  634. # This was the old proc, which didn't have Stta::indentLine available.
  635. # 
  636. # Indenting continuation lines by one space relative to start of command. 
  637. # (Note: Inserting space at first was the only way I was able to get this
  638. # to work when at the end of the last line of a file.  -- lps)
  639.  
  640. # proc Stta::continueCommand {} {
  641. #     insertText " "
  642. #     backwardChar
  643. #     set begHere [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ (\*\/)\t\r\n]} [getPos]]
  644. #     set indAmt [getText [lindex $begHere 0] [pos::math [lindex $begHere 1] -1]]
  645. #     insertText " /*\r$indAmt */"
  646. #     forwardChar
  647. # }
  648.  
  649. # ===========================================================================
  650. #
  651. # ◊◊◊◊ Indentation ◊◊◊◊ #
  652. # 
  653. # Stta::correctIndentation is necessary for Smart Paste, and returns the
  654. # correct level of indentation for the current line.  Stta::indentLine uses
  655. # this level to indent the current line.
  656. # 
  657. # We have three levels of indentation in Stata.  The first is for the
  658. # continuation of commands, in which case we simply indent respecting the
  659. # Stta mode variable fullIndent.  The second is for programs, in which case
  660. # we indent the start of each command by indentationAmount until we reach
  661. # an "end" command.  The third is for nested {} statements.
  662. # 
  663. # In Stta::correctIndentation, we grab the previous line, remove all of the
  664. # characters besides braces and quotes, and then convert it all to a list
  665. # to be evaluated.  Braces contained within quotes, as well as literal
  666. # characters, should all be ignored and the remaining braces are used to
  667. # determine the correct level of nesting.
  668. # 
  669. # This works really well for "simple" syntax files, without multi-line
  670. # block commented sections embedded in either program definitions or actual
  671. # commands.
  672. # 
  673. # Known limitation (or a feature, depending on your point of view):
  674. # Indented lines of block comments will be recognized as "valid"
  675. # commands that are being continued, and themselves indented when a region
  676. # is formatted, leading to a construction that looks like this:
  677. # 
  678. #       command var
  679. #       
  680. #       /* 
  681. #           * It is important to note that the CPS files produced
  682. #           * by the Census Bureau do not have decimal points in
  683. #           * the data.  
  684. #           */
  685. #        
  686. #       next command var
  687. # 
  688. # or maybe
  689. # 
  690. #       command var
  691. #       
  692. #       /*  It is left to the documentation to inform
  693. #           the user how many decimals are implied.  The user
  694. #           must make the proper adjustment before using
  695. #           weights.  This is true for all the weights. 
  696. #           */
  697. # 
  698. # In this case, it's important that the ending */ appear on a line by
  699. # itself to signal that this line was a "continued" command, now complete. 
  700. # It all gets messier when trying to figure out what a syntax file "should"
  701. # look like given the semi delimiter possibility, too ...
  702. # 
  703.  
  704. proc Stta::indentLine {{pos ""}} {
  705.     
  706.     if {$pos == ""} {set pos [getPos]} 
  707.     # Get details of current line.
  708.     set posBeg [lineStart [getPos]]
  709.     set text [getText $posBeg [nextLineStart $posBeg]]
  710.     regexp {^[ \t]*} $text white 
  711.     set posNext1 [pos::math $posBeg + [string length $white]]
  712.     set posNext2 [pos::math $posNext1 + 1]
  713.     if {[pos::compare $posNext2 > [maxPos]]} {
  714.         set posNext2 [maxPos]
  715.     } 
  716.     # Determine the correct level of indentation for this line, given the
  717.     # next character.
  718.     set lwhite [Stta::correctIndentation $pos [getText $posNext1 $posNext2]]
  719.     set lwhite [text::indentOf $lwhite]
  720.     if {$white != $lwhite} {
  721.         replaceText $posBeg $posNext1 $lwhite
  722.     }
  723.     goto [pos::math $posBeg + [string length $lwhite]]
  724. }
  725.  
  726. proc Stta::correctIndentation {pos {next ""}} {
  727.     
  728.     global mode indent_amounts SttamodeVars
  729.     
  730.     if {$mode == "Stta"} {
  731.         set continueIndent [expr {$SttamodeVars(fullIndent) + 1}]
  732.     } else {
  733.         set continueIndent 2
  734.     } 
  735.     
  736.     set posBeg   [lineStart $pos]
  737.     # Get information about this line, previous line ...
  738.     set thisLine  [Stta::getCommandLine $posBeg 1 2]
  739.     set prevLine1 [Stta::getCommandLine [pos::math $posBeg - 1] 0 2]
  740.     set prevLine2 [Stta::getCommandLine [pos::math [lindex $prevLine1 0] - 1] 0 2]
  741.     set lwhite    [lindex $prevLine1 1]
  742.     # If we have a previous line ...
  743.     if {[pos::compare [lindex $prevLine1 0] != $posBeg]} {
  744.         set pL1 [string trim [lindex $prevLine1 2]]
  745.         # Indent if the preceding command was a program definition.
  746.         if {[regexp {^[\t ]*program+[\t ]+define} $pL1]} {
  747.             incr lwhite $indent_amounts(2)
  748.         } 
  749.         # Indent if the last line did not terminate the command.
  750.         if {![Stta::endOfCommand $pL1]} {
  751.             incr lwhite $indent_amounts($continueIndent)
  752.         } 
  753.         # Check to make sure that the previous command was not itself a
  754.         # continuation of the line before it.
  755.         if {[pos::compare [lindex $prevLine1 0] != [lindex $prevLine2 0]]} {
  756.             set pL2 [string trim [lindex $prevLine2 2]]
  757.             if {![Stta::endOfCommand $pL2]} {
  758.                 incr lwhite $indent_amounts(-$continueIndent)
  759.             } 
  760.         }
  761.         # Find out if there are any unbalanced {,},(,) in the last line.
  762.         regsub -all {[^ \{\}\(\)\"\*\/\\]} $pL1 { } line
  763.         # Remove all literals.
  764.         regsub -all {\\\{|\\\}|\\\(|\\\)|\\\"|\\\*|\\\/} $line { } line
  765.         regsub -all {\\} $line { } line
  766.         # Remove everything surrounded by quotes.
  767.         regsub -all {\"([^\"]+)\"} $line { } line
  768.         regsub -all {\"} $line { } line
  769.         # Remove everything surrounded by bracketed comments.
  770.         regsub -all {/\*([^\*/]+)\*/} $line { } line
  771.         # Now turn all braces into 2's and -2's
  772.         regsub -all {\{|\(} $line { 2 }  line
  773.         regsub -all {\}|\)} $line { -2 } line
  774.         # This list should now only contain 2's and -2's.
  775.         foreach i $line {
  776.             if {$i == "2" || $i == "-2"} {incr lwhite $indent_amounts($i)} 
  777.         }
  778.        # Did the last line start with a lone \) or \} ?  If so, we want to
  779.         # keep the indent, and not make call it an unbalanced line.
  780.         if {[regexp {^[\t ]*(\}|\))} $pL1]} {
  781.             incr lwhite $indent_amounts(2)
  782.         } 
  783.     } 
  784.     # If we have a current line ...
  785.     if {[pos::compare [lindex $thisLine 0] == $posBeg]} {
  786.         # Reduce the indent if the first non-whitespace character of this
  787.         # line is ) or \}, or an "end" command.
  788.         set tL [lindex $thisLine 2]
  789.         if {$next == "\}" || $next == ")" || [regexp {^[\t ]*(\}|\)|end)} $tL]} {
  790.             incr lwhite $indent_amounts(-2)
  791.         } 
  792.     } 
  793.     # Now we return the level to the calling proc.
  794.     return [expr {$lwhite > 0 ? $lwhite : 0}]
  795. }
  796.  
  797. # ===========================================================================
  798. # 
  799. # Get Command Line
  800. # 
  801. # Find the next/prev command line relative to a given position, and return
  802. # the position in which it starts, its indentation, and the complete text
  803. # of the command line.  If the search for the next/prev command fails,
  804. # return an indentation level of 0.
  805. # 
  806. # Unlike SPSS and SAS modes, we don't have the luxury of ignoring commented
  807. # lines since they could simply indicate the continuation of commands.
  808. # 
  809.  
  810. proc Stta::getCommandLine {pos {direction 1} {ignoreComments 1}} {
  811.     
  812.     if {$ignoreComments == 1} {
  813.         set pat {^[\t ]*[^\t\r\n\*/ ]}
  814.     } elseif {$ignoreComments == 2} {
  815.         set pat {^[\t ]*[^\t\r\n/ ]}
  816.     } else {
  817.         set pat {^[\t ]*[^\t\r\n ]}
  818.     } 
  819.     set posBeg [pos::math [lineStart $pos] - 1]
  820.     if {[pos::compare $posBeg < [minPos]]} {
  821.         set posBeg [minPos]
  822.     } 
  823.     set lwhite 0
  824.     if {![catch {search -f $direction -r 1 $pat $pos} match]} {
  825.         set posBeg [lindex $match 0]
  826.         set lwhite [posX [pos::math [lindex $match 1] - 1]]
  827.     }
  828.     set posEnd [pos::math [nextLineStart $posBeg] - 1]
  829.     if {[pos::compare $posEnd > [maxPos]]} {
  830.         set posEnd [maxPos]
  831.     } 
  832.     return [list $posBeg $lwhite [getText $posBeg $posEnd]]
  833. }
  834.  
  835. # ===========================================================================
  836. # 
  837. # End of Command
  838. # 
  839. # Determine if the command in a line of a given position was terminated.
  840. # 
  841.  
  842. proc Stta::endOfCommand {line} {
  843.     
  844.     global SttamodeVars
  845.     
  846.     if {!$SttamodeVars(semiDelimiter)} {
  847.         # Check to see if the last line ended with /*, indicating continuation.
  848.         if {[regexp {/\*([^\*]*)$} $line]} {
  849.             return 0
  850.         } else {
  851.             return 1
  852.         }
  853.     } else {
  854.         # Check to see if the last line ended with ;, indicating termination.
  855.         if {[regexp {;([\t ]?)$} $line]} {
  856.             return 1
  857.         } else {
  858.             return 0
  859.         } 
  860.     }
  861. }
  862.  
  863. # ===========================================================================
  864. # 
  865. # ◊◊◊◊ Command Double Click ◊◊◊◊ #
  866. # 
  867. # First checks to see if this is a macro defined in current window.
  868. # 
  869. # Then checks to see if the highlighted word appears in any keyword list,
  870. # and if so, sends the selected word to the www.stata.com help site.  Stata
  871. # commands are case-sensitive, and so is the help search engine.
  872. #
  873. # Control-Command double click will insert syntax information in status bar.
  874. # Shift-Command double click will insert commented syntax information in window.
  875. # Option-Command double click will send the command to Stata application. (lps)
  876. # 
  877. # If "Local Help" is checked, option vs not is reversed, so that command
  878. # double-click will send to local Stata application.
  879. # 
  880.  
  881. proc Stta::DblClick {from to shift option control} {
  882.     
  883.     global SttamodeVars SttaCommands  SttaPrefixes   SttaParameters SttaFunctions 
  884.     global SttaModifiers SttaMacros   SttaDated      SttaSyntaxMessage
  885.     
  886.     set validCommands  [concat                                          \
  887.       $SttaCommands  $SttaPrefixes $SttaParameters $SttaFunctions       \
  888.       $SttaModifiers $SttaMacros   $SttaDated                           \
  889.       ]
  890.     
  891.     select $from $to
  892.     set command [getSelect]
  893.     set macroDef {program[\t ]define[\t ]*$command[\t\r\n; ]}
  894.     
  895.     if {![catch {search -f 1 -r 1 $macroDef [minPos]} match]} {
  896.         # First check current file for macro definition, and if found ...
  897.         placeBookmark
  898.         goto [lineStart [lindex $match 0]]
  899.         message "press <Ctl .> to return to original cursor position"
  900.         return
  901.         # Could next check any open windows, or files in the current
  902.         # window's folder ...  but not implemented.  For now, macros need
  903.         # to be defined in current file.
  904.     } elseif {[lsearch -exact $validCommands $command] == "-1"} {
  905.         # If not a defined macro, check to see if it's a defined keyword.
  906.         message "\"$command\" is not defined as a Stata system keyword."
  907.         return
  908.     }
  909.     # Any modifiers pressed?
  910.     if {$control} {
  911.         # CONTROL -- Just put syntax message in status bar window
  912.         if {[info exists SttaSyntaxMessage($command)]} {
  913.             message $SttaSyntaxMessage($command)        
  914.         } else {
  915.             message "Sorry, no syntax information available for $command"
  916.         } 
  917.     } elseif {$shift} {
  918.         # SHIFT --Just insert syntax message as commented text
  919.         if {[lsearch -exact $SttaDated $command] != "-1"} {
  920.             message "$SttaSyntaxMessage($command)"
  921.         } elseif {[info exists SttaSyntaxMessage($command)]} {
  922.             endOfLine
  923.             insertText "\r"
  924.             insertText "$SttaSyntaxMessage($command)"
  925.             comment::Line
  926.         } else {
  927.             message "Sorry, no syntax information available for $command"
  928.         } 
  929.     } elseif {$option && !$SttamodeVars(localHelp)} {
  930.         # Now we have four possibilities, based on "option" key and the
  931.         # preference for "local Help".
  932.         # 
  933.         # OPTION, local help isn't checked -- Send command to local application
  934.         Stta::localCommandHelp $command
  935.     } elseif {$option && $SttamodeVars(localHelp)} {
  936.         # OPTION, but local help is checked -- Send command for on-line help.
  937.         Stta::wwwCommandHelp $command
  938.     } elseif {$SttamodeVars(localHelp)} {
  939.         # No modifiers, local help is checked -- Send command to local app.
  940.         Stta::localCommandHelp $command
  941.     } else {
  942.         # No modifiers, no local help checked -- Send command for on-line
  943.         # help.  This is the "default" behavior.
  944.         Stta::wwwCommandHelp $command
  945.     }
  946. }
  947.  
  948. # ===========================================================================
  949. # 
  950. # WWW Command Help
  951. # 
  952. # Send command to defined url, prompting for text if necessary.
  953. # 
  954.  
  955. proc Stta::wwwCommandHelp {{command ""}} {
  956.     
  957.     global SttamodeVars
  958.     
  959.     if {$command == ""} {
  960.         set command [prompt "on-line help for ... " [getSelect]] 
  961.         # set command [statusPrompt "on-line help for ... " ] 
  962.     } 
  963.     message "\"$command\" sent to $SttamodeVars(helpUrl)"
  964.     url::execute $SttamodeVars(helpUrl)$command
  965. }
  966.  
  967. # ===========================================================================
  968. # 
  969. # Local Command Help
  970. # 
  971. # Send command to local application, prompting for text if necessary.
  972. # 
  973. # -- lps
  974. # 
  975. # Supposedly, this works on all platforms ... -- cbu
  976. # 
  977.  
  978. proc Stta::localCommandHelp {{command ""}} {
  979.     
  980.     if {$command == ""} {
  981.         set command [prompt "local Stata application help for ... " [getSelect]] 
  982.         # set command [statusPrompt "local Stata application help for ... " ] 
  983.     } 
  984.     Stta::doSelection "whelp $command"
  985. }
  986.  
  987. # ===========================================================================
  988. # 
  989. # Command Help
  990. # 
  991. # Send the command to a local Stata application if it exists, otherwise
  992. # send it the defined web site.  (Used in the "Statistical Modes Help"
  993. # file, could easily be used in the menu if desired ...)
  994. # 
  995.  
  996. proc Stta::commandHelp {{command ""}} {
  997.     
  998.     global SttamodeVars tcl_platform
  999.     
  1000.     if {$command == ""} {
  1001.         set command [prompt "Stata help for ..." ""]
  1002.     } 
  1003.     if {[set command [string trim $command]] == ""} {
  1004.         message "Cancelled -- no command was entered."
  1005.         error "No command was entered."
  1006.     } 
  1007.     if {[regexp $command " "]} {
  1008.         message "Cancelled -- only enter one command for help."
  1009.         error "Multiple commands requested."
  1010.     } 
  1011.     set pf $tcl_platform(platform)
  1012.     set local 0
  1013.     if {$pf == "macintosh" && ![catch {nameFromAppl $SttamodeVars(stataSig)}]} {
  1014.         set local 1
  1015.     } elseif {($pf == "windows" && [file exists $SttamodeVars(stataSig)]} {
  1016.         set local 1
  1017.     } elseif {($pf == "unix" && [file exists $SttamodeVars(stataSig)]} {
  1018.         set local 1
  1019.     } 
  1020.     if {$local} {
  1021.         Stta::localCommandHelp $command
  1022.     } else {
  1023.         Stta::wwwCommandHelp $command
  1024.     } 
  1025. }
  1026.  
  1027. # ===========================================================================
  1028. # 
  1029. # ◊◊◊◊ Mark File and Parse Functions ◊◊◊◊ #
  1030. #
  1031.  
  1032. # ===========================================================================
  1033. # 
  1034. # Stta Mark File
  1035. # 
  1036. # This will return the first 35 characters from the first non-commented
  1037. # word appearing in column 0.  Codebook files will be marked differently,
  1038. # listing variable names.  All other output files (those not recognized)
  1039. # will take into account the additional left margin elements added by
  1040. # Stata.
  1041. #
  1042.  
  1043. proc Stta::MarkFile {{type ""}} {
  1044.     
  1045.     removeAllMarks
  1046.     
  1047.     message "Marking File …"
  1048.     
  1049.     set pos [minPos]
  1050.     set count 0
  1051.     # Figure out what type of file this is -- source, codebook, or output.
  1052.     # The variable "type" refers to a call from the Stata menu.
  1053.     # Otherwise we try to figure out the type based on the file's suffix.
  1054.     if {$type == ""} {
  1055.         if {[win::CurrentTail] == "* Stta Mode Example *"} {
  1056.             # Special case for Mode Examples, but only if called from
  1057.             # Marks menu.  (Called from Stata menu, "type" will over-ride.
  1058.             set type  ".do"
  1059.         } else {
  1060.             set type [file extension [win::CurrentTail]]
  1061.         }
  1062.     }
  1063.     # Now set the mark regexp.
  1064.     if {$type == ".do" || $type == ".ado"  } {
  1065.         # Source file.
  1066.         set markExpr {^(!+[\t ]|\*\*\*[ ]|\*\*\*\*[ ])?[a-zA-Z0-9_\#]}
  1067.     } elseif {$type == ".codebook"} {
  1068.         # Codebook file, called from the Stata menu
  1069.         set markExpr {^[a-zA-Z0-9]+( \-)}
  1070.     } else {
  1071.         # None of the above, so assume that it's output
  1072.         set markExpr {^(\. )+((!+[\t ]|\*\*\*[ ]|\*\*\*\*[ ])?[a-zA-Z0-9_\#])}
  1073.     }
  1074.     # Mark the file
  1075.     while {![catch {search -f 1 -r 1 -m 0 -i 1 $markExpr $pos} match]} {
  1076.         incr count
  1077.         set posBeg [lindex $match 0]
  1078.         set posEnd [nextLineStart $posBeg]
  1079.         if {[pos::compare $posEnd > [maxPos]]} {set posEnd [maxPos]} 
  1080.         set line   [string trimright [getText $posBeg $posEnd]]
  1081.         # Get rid of the leading ". " for output files
  1082.         set line   [string trimleft  $line ". "]
  1083.         # Get rid of braces.
  1084.         regsub -all {\{|\[} $line {(} line
  1085.         regsub -all {\}|\]} $line {)} line
  1086.         # Add a little indentation so that section marks show up better.
  1087.         set line  "  $line"
  1088.         if {[regsub {  \*\*\*\* } $line {* } line]} {
  1089.             incr count -1
  1090.         } elseif {[regsub {  \*\*\* } $line {• } line]} {
  1091.             incr count -1
  1092.         } 
  1093.         if {[string length $line] > 35} {
  1094.             set line "[string range $line 0 35] …"
  1095.         } else {
  1096.             # Get rid of trailing sem-colons.
  1097.             set line  [string trimright $line ";" ]
  1098.         }
  1099.         if {$type == ".codebook"} {
  1100.             # Get rid of the trailing "-" for frequency / codebook files.
  1101.             regsub {[-]+( …)} $line { } line
  1102.             set line [string trimleft  $line " "]
  1103.             message "# of variables: $count"
  1104.         }
  1105.         setNamedMark $line $posBeg $posBeg $posBeg
  1106.         set pos $posEnd
  1107.     }
  1108.     # Sorting the marks if this is a codebook.
  1109.     # (Code lifted from "sortMarksFile", in "marks.tcl")
  1110.     if {$type == ".codebook"} {
  1111.         message "Sorting marks …"
  1112.         set mks {}
  1113.         foreach mk [getNamedMarks] {
  1114.             removeNamedMark -n [lindex $mk 0] -w [lindex $mk 1]
  1115.             lappend mks $mk
  1116.         }
  1117.         foreach mk   [lsort $mks] {
  1118.             set name [lindex $mk 0]
  1119.             set disp [lindex $mk 2]
  1120.             set pos  [lindex $mk 3]
  1121.             set end  [lindex $mk 4]
  1122.             
  1123.             setNamedMark $name $disp $pos $end
  1124.         }
  1125.         message "This codebook describes $count variables."
  1126.     } else {
  1127.         message "This file contains $count commands."
  1128.     } 
  1129. }
  1130.  
  1131. # ===========================================================================
  1132. # 
  1133. # Stta Parse Functions
  1134. # 
  1135. # This will return only the Stta command names.  All other output files
  1136. # (those not recognized) will take into account the additional left margin
  1137. # elements added by Stata.
  1138. # 
  1139.  
  1140. proc Stta::parseFuncs {} {
  1141.     
  1142.     global sortFuncsMenu
  1143.     
  1144.     set ext [file extension [win::CurrentTail]]
  1145.     
  1146.     # Determine the file type.
  1147.     if {$ext == ".do" || $ext == ".ado"} {
  1148.         set funcExpr {^(\w+)}
  1149.     } elseif {[file tail [win::Current]] == "* Stta Mode Example *"} {
  1150.         # Special case for Mode Examples folder
  1151.         set funcExpr {^(\w+)}
  1152.     } else {
  1153.         # We don't worry about codebooks here, we'll just parse as output.
  1154.         set funcExpr {^(\. )(\w+)}
  1155.     }
  1156.     # Parse the file.
  1157.     set pos [minPos]
  1158.     set m {}
  1159.     while {[set match [search -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  1160.         if {[regexp -- {(\w+)} [eval getText $match] "" word]} {
  1161.             lappend m [list $word [lindex $match 0]]
  1162.         }
  1163.         set pos [lindex $match 1]
  1164.     }
  1165.     # Sort the functions if necessary, but regsub either way.
  1166.     if {$sortFuncsMenu} {
  1167.         regsub -all "\[\{\}\]" [lsort -ignore $m] "" m
  1168.     } else {
  1169.         regsub -all "\[\{\}\]" $m "" m
  1170.     }   
  1171.     return  $m
  1172. }
  1173.  
  1174. # ===========================================================================
  1175. # 
  1176. # ◊◊◊◊ -------------------- ◊◊◊◊ #
  1177. # 
  1178. # ◊◊◊◊ Stata Menu ◊◊◊◊ #
  1179. # 
  1180. # version: 1.2
  1181. # 
  1182. # Author: L. Phillip Schumm
  1183. # E-mail: <pschumm@uchicago.edu>
  1184. # 
  1185. # If Stata is launched from Alpha, then Stata's own directory will become
  1186. # the working directory unless a profile.do file is used to change it.
  1187. #
  1188. # version history:
  1189. # 
  1190. # 1.1  lps  Contributed menu to stataMode.tcl
  1191. # 1.2  cbu  Added "Mark File As", simplified Stta::menuProc .
  1192. #           Added "Help", added optional argument to doFile .
  1193. #           Changed "Menu -n ..." proc to "menu::buildProc stataMenu ...".
  1194. # 1.3  cbu  Added more preferences to Help section, and Navigation section.
  1195. # 2.0  cbu  Updated for Alpha 7.4, added "Stata Home Page" menu item.
  1196. # 2.1  cbu  Added "Keywords" submenu, cleaning up "Help"
  1197. # 
  1198.  
  1199. # This was the old menu definition proc.
  1200.  
  1201. # Menu -n $stataMenu -p Stta::menuProc -M Stta {
  1202. #     "/S<U<OswitchToStata"
  1203. #     "(-"
  1204. #     "/D<U<OdoFile"
  1205. #     "/D<U<O<BdoSelection"
  1206. #     {Menu -n markStataFileAs -p Stta::markFileProc {
  1207. #         "source"
  1208. #         "output"
  1209. #         "codebook"  }
  1210. #     }
  1211. #     {Menu -n StataHelp -p Stta::helpProc {
  1212. #         "/t<BstataModeHelp"
  1213. #         "/t<IlocalCommandHelp…"
  1214. #         "/t<OwwwCommandHelp…" }
  1215. #     }
  1216. #     "(-"
  1217. #     "/P<U<OinsertPath"
  1218. #     "/P<U<O<BprogramTemplate"
  1219. # }
  1220.  
  1221. # Tell Alpha what procedures to use to build all menus, submenus.
  1222.  
  1223. menu::buildProc stataMenu           Stta::buildMenu
  1224. menu::buildProc stataHelp           Stta::buildHelpMenu
  1225. menu::buildProc stataKeywords       Stta::buildKeywordsMenu
  1226. menu::buildProc markStataFileAs…    Stta::buildMarkMenu
  1227.  
  1228. # First build the main Stata menu.
  1229.  
  1230. proc Stta::buildMenu {} {
  1231.     
  1232.     global stataMenu
  1233.     
  1234.     set menuList [list                                  \
  1235.       "stataHomePage"                                   \
  1236.       "/S<U<OswitchToStata"                             \
  1237.       [list Menu -n stataHelp           -M Stta {}]     \
  1238.       "(-"                                              \
  1239.       [list Menu -n stataKeywords       -M Stta {}]     \
  1240.       [list Menu -n markStataFileAs…    -M Stta {}]     \
  1241.       "(-"                                              \
  1242.       "/D<U<OdoFile"                                    \
  1243.       "/D<U<O<BdoSelection"                             \
  1244.       "(-"                                              \
  1245.       "/P<U<OinsertPath"                                \
  1246.       "/P<U<O<BprogramTemplate"                         \
  1247.       "/b<UcontinueCommand"                             \
  1248.       "(-"                                              \
  1249.       "/N<U<BnextCommand"                               \
  1250.       "/P<U<BprevCommand"                               \
  1251.       "/S<U<BselectCommand"                             \
  1252.       "/I<B<OreformatCommand"                           \
  1253.       ]
  1254.     set submenus [list stataHelp stataKeywords markStataFileAs… ]
  1255.     return       [list build $menuList Stta::menuProc $submenus $stataMenu]
  1256. }
  1257.  
  1258. # Then build the "Stata Help" submenu.
  1259.  
  1260. proc Stta::buildHelpMenu {} {
  1261.     
  1262.     global SttamodeVars SttaPrefsInMenu alpha::platform
  1263.     
  1264.     # Determine which key should be used for "Help", with F8 as option.
  1265.     
  1266.     if {!$SttamodeVars(noHelpKey)} {
  1267.         set key "/t"
  1268.     } else {
  1269.         set key "/l"
  1270.     } 
  1271.     
  1272.     # Reverse the local, www key bindings depending on the value of the
  1273.     # 'Local Help" variable.
  1274.     
  1275.     if {!$SttamodeVars(localHelp)} {
  1276.         set menuList [list                  \
  1277.           "${key}<OwwwCommandHelp…"         \
  1278.           "${key}<IlocalCommandHelp…"       \
  1279.           ]
  1280.     } else {
  1281.         set menuList [list                  \
  1282.           "${key}<OlocalCommandHelp…"       \
  1283.           "${key}<IwwwCommandHelp…"         \
  1284.           ]
  1285.     } 
  1286.     lappend menuList "(-"
  1287.     if {${alpha::platform} == "alpha"} {
  1288.         set prefix "!√"
  1289.     } else {
  1290.         set prefix "!•"
  1291.     } 
  1292.     foreach pref $SttaPrefsInMenu {
  1293.         if {$SttamodeVars($pref)} {
  1294.             if {$pref == "semiDelimiter"} {set pref "/;<U<B$pref"}
  1295.             lappend menuList "${prefix}$pref"
  1296.         } else {
  1297.             if {$pref == "semiDelimiter"} {set pref "/;<U<B$pref"}
  1298.             lappend menuList "$pref"
  1299.         }
  1300.     }
  1301.     lappend menuList "(-"
  1302.     lappend menuList "setStataApplication"
  1303.     lappend menuList "(-"
  1304.     lappend menuList "${key}<BstataModeHelp"
  1305.     
  1306.     return [list build $menuList Stta::helpProc {}]
  1307. }
  1308.  
  1309. # Then build the "Stta Mode Keywords" submenu.
  1310.  
  1311. proc Stta::buildKeywordsMenu {} {
  1312.     
  1313.     set menuList [list                  \
  1314.       "listKeywords"                    \
  1315.       "checkKeywords"                   \
  1316.       "addNewCommands"                  \
  1317.       "addNewOptions"                   \
  1318.       ]
  1319.     return [list build $menuList Stta::keywordsProc {}]
  1320. }
  1321.  
  1322. # Then build the "Mark Stata File As" submenu.
  1323.  
  1324. proc Stta::buildMarkMenu {} {
  1325.     
  1326.     global SttamodeVars alpha::platform
  1327.     
  1328.     set menuList [list                  \
  1329.       "source"                          \
  1330.       "output"                          \
  1331.       "codebook"                        \
  1332.       "(-"                              \
  1333.       ]
  1334.     if {${alpha::platform} == "alpha"} {
  1335.         set prefix "!√"
  1336.     } else {
  1337.         set prefix "!•"
  1338.     } 
  1339.     if {$SttamodeVars(autoMark)} {
  1340.         lappend menuList "${prefix}autoMark"
  1341.     } else {
  1342.         lappend menuList "autoMark"        
  1343.     }
  1344.  
  1345.     return [list build $menuList Stta::markFileProc {}]
  1346. }
  1347.  
  1348.  
  1349. proc Stta::rebuildMenu {{menuName "stataMenu"} {pref ""}} {
  1350.     menu::buildSome $menuName
  1351. }
  1352.  
  1353. # Dim some menu items when there are no open windows.
  1354. set menuItems {
  1355.     markStataFileAs… doFile doSelection 
  1356.     insertPath programTamplate continueCommand
  1357.     nextCommand prevCommand selectCommand reformatCommand
  1358. }
  1359. foreach i $menuItems {
  1360.     hook::register requireOpenWindowsHook [list stataMenu $i] 1
  1361. } 
  1362. unset i menuItems 
  1363.  
  1364. # Now we actually build the Stata menu.
  1365.  
  1366. menu::buildSome stataMenu
  1367.  
  1368. # ===========================================================================
  1369. # 
  1370. # ◊◊◊◊ Stata menu support ◊◊◊◊ #
  1371. # 
  1372.  
  1373. # This is the procedure called for all main menu items.
  1374.  
  1375. proc Stta::menuProc {menuName item} {Stta::$item}
  1376.  
  1377. # Give a beta message for untested features / menu items.
  1378.  
  1379. proc Stta::betaMessage {{kill 1}} {
  1380.     
  1381.     message "Sorry,this feature has not been fully implemented."
  1382.     if {$kill} {return -code return}
  1383. }
  1384.  
  1385. # ===========================================================================
  1386. # 
  1387. # Open the Stata home page.
  1388. # 
  1389.  
  1390. proc Stta::stataHomePage {} {
  1391.  
  1392.     global SttamodeVars
  1393.     
  1394.     url::execute $SttamodeVars(stataHomePage)
  1395. }
  1396.  
  1397. # ===========================================================================
  1398. # 
  1399. # Switch to Stata application.
  1400. # 
  1401.  
  1402. proc Stta::switchToStata {} {app::launchFore [Stta::sig]}
  1403.  
  1404. # ===========================================================================
  1405. # 
  1406. # Return the Stata signature.
  1407. # 
  1408.  
  1409. proc Stta::sig {{app "Stata"}} {
  1410.     
  1411.     global SttamodeVars tcl_platform
  1412.     
  1413.     set lowApp [string tolower $app]
  1414.     set capApp [string toupper $app]
  1415.     set pf     $tcl_platform(platform)
  1416.  
  1417.     if {$pf == "macintosh"} {
  1418.         # Make sure that the Macintosh application for the signature exists.
  1419.         if {[catch {nameFromAppl $SttamodeVars(${lowApp}Sig)}]} {
  1420.             alertnote "Looking for the $capApp application ..."
  1421.             Stta::setApplication $lowApp
  1422.         }
  1423.     } elseif {$pf == "windows" || $pf == "unix"} {
  1424.         # Make sure that the Windows application for the signature exists. 
  1425.         # We assume that this will work for unix, too.
  1426.         if {![file exists $SttamodeVars(${lowApp}Sig)]} {
  1427.             alertnote "Looking for the $capApp application ..."
  1428.             Stta::setApplication $lowApp
  1429.         }
  1430.     }
  1431.     return $SttamodeVars(${lowApp}Sig)
  1432. }
  1433.  
  1434. # ===========================================================================
  1435. # 
  1436. # Set Application
  1437. # 
  1438. # Prompt the user to locate the local Stata application.
  1439. # 
  1440.  
  1441. proc Stta::setApplication {{app "Stata"}} {
  1442.     
  1443.     global mode SttamodeVars
  1444.     
  1445.     set lowApp [string tolower $app]
  1446.     set capApp [string toupper $app]
  1447.     
  1448.     set newSig ""
  1449.     set newSig [dialog::askFindApp $capApp $SttamodeVars(${lowApp}Sig)]
  1450.     
  1451.     if {$newSig != ""} {
  1452.         set SttamodeVars(${lowApp}Sig) "$newSig"
  1453.         set oldMode $mode
  1454.         set mode "Stta"
  1455.         synchroniseModeVar "${lowApp}Sig" $SttamodeVars(${lowApp}Sig)
  1456.         set mode $oldMode
  1457.         message "The $capApp signature has been changed to \"$newSig\"."
  1458.     } else {
  1459.         message "Cancelled."
  1460.     }
  1461. }
  1462.  
  1463. # ===========================================================================
  1464. # 
  1465. # ◊◊◊◊ Help ◊◊◊◊ #
  1466. # 
  1467.  
  1468. proc Stta::helpProc {menuName item} {
  1469.  
  1470.     global SttamodeVars SttaPrefsInMenu
  1471.     
  1472.     if {$item == "wwwCommandHelp"} {
  1473.         Stta::wwwCommandHelp
  1474.     } elseif  {$item == "localCommandHelp"} {
  1475.         Stta::localCommandHelp
  1476.     } elseif {[lsearch -exact $SttaPrefsInMenu $item] != -1} {
  1477.         Stta::flagFlip $item
  1478.         Stta::rebuildMenu stataHelp
  1479.     } elseif {$item == "setStataApplication"} {
  1480.         Stta::setApplication "Stata"
  1481.     } elseif {$item == "stataModeHelp"} {
  1482.         package::helpFile "Stta"
  1483.     } else {
  1484.         Stta::$item
  1485.     } 
  1486. }
  1487.  
  1488. # ===========================================================================
  1489. # 
  1490. # ◊◊◊◊ Keywords ◊◊◊◊ #
  1491. # 
  1492.  
  1493. proc Stta::keywordsProc {menuName item} {
  1494.  
  1495.     global Sttacmds
  1496.     
  1497.     if {$item == "listKeywords"} {
  1498.         set keywords [listpick -l -p "Current Stata mode keywords…" $Sttacmds]
  1499.         foreach keyword $keywords {
  1500.             Stta::checkKeywords $keyword
  1501.         }
  1502.     } elseif {$item == "addNewCommands" || $item == "addNewOptions"} {
  1503.         set item [string trimleft $item "addNew"]
  1504.         if {$item == "Commands" && [llength [winNames]] && [askyesno \
  1505.           "Would you like to add all of the \"extra\" commands from this window\
  1506.           to the \"Add Commands\" preference?"] == "yes"} {
  1507.             Stta::addWindowCommands
  1508.         } else {
  1509.             Stta::addKeywords $item
  1510.         }
  1511.     } else {
  1512.         Stta::$item
  1513.     } 
  1514. }
  1515.  
  1516. # ===========================================================================
  1517. # 
  1518. # Stta::addWindowCommands
  1519. # 
  1520. # Add all of the "extra" commands which appear in entries in this window.
  1521. # 
  1522.  
  1523. proc Stta::addWindowCommands {} {
  1524.     
  1525.     global mode Sttacmds SttamodeVars
  1526.     
  1527.     if {![llength [winNames]]} {
  1528.         message "Cancelled -- no current window!"
  1529.         return
  1530.     } 
  1531.     
  1532.     message "Scanning [win::CurrentTail] for all commands…"
  1533.     
  1534.     set pos [minPos]
  1535.     set pat {^([a-zA-Z0-9]+[a-zA-Z0-9])+[\t ]}
  1536.     while {![catch {search -f 1 -r 1 $pat $pos} match]} {
  1537.         set pos [nextLineStart [lindex $match 1]]
  1538.         set commandLine [getText [lindex $match 0] [lindex $match 1]]
  1539.         regexp $pat $commandLine match aCommand
  1540.         if {![lcontains Sttacmds $aCommand]} {
  1541.             append SttamodeVars(addCommands) " $aCommand"
  1542.         } 
  1543.     }
  1544.     set SttamodeVars(addCommands) [lsort [lunique $SttamodeVars(addCommands)]]
  1545.     set oldMode $mode
  1546.     set mode "Stta"
  1547.     synchroniseModeVar addCommands $SttamodeVars(addCommands)
  1548.     set mode $oldMode
  1549.     if {[llength $SttamodeVars(addCommands)]} {
  1550.         Stta::colorizeStta
  1551.         listpick -p "The \"Add Commands\" preference includes:" \
  1552.           $SttamodeVars(addCommands)
  1553.         message "Use the \"Mode Prefs --> Preferences\" menu item to edit keyword lists."
  1554.     } else {
  1555.         message "No \"extra\" commands from this window were found."
  1556.     } 
  1557. }
  1558.  
  1559. # ===========================================================================
  1560. # 
  1561. # Stta::addKeywords
  1562. # 
  1563. # Prompt the user to add keywords for a given category.
  1564. # 
  1565.  
  1566. proc Stta::addKeywords {{category} {keywords ""}} {
  1567.  
  1568.     global mode SttamodeVars
  1569.     
  1570.     if {$keywords == ""} {
  1571.         set keywords [prompt "Enter new Stata $category:" ""]
  1572.     }
  1573.     
  1574.     # Check to see if the keyword is already defined.
  1575.     foreach keyword $keywords {
  1576.         set checkStatus [Stta::checkKeywords $keyword 1 0]
  1577.         if {$checkStatus != 0} {
  1578.             alertnote "Sorry, \"$keyword\" is already defined\
  1579.               in the $checkStatus list."
  1580.             message "Cancelled."
  1581.             return -code return
  1582.         } 
  1583.     }
  1584.     # Keywords are all new, so add them to the appropriate mode preference.
  1585.     append SttamodeVars(add$category) " $keywords"
  1586.     set SttamodeVars(add$category) [lsort $SttamodeVars(add$category)]
  1587.     set oldMode $mode
  1588.     set mode "Stta"
  1589.     synchroniseModeVar add$category $SttamodeVars(add$category)
  1590.     set mode $oldMode
  1591.     Stta::colorizeStta
  1592.     message "\"$keywords\" added to $category preference."
  1593. }
  1594.  
  1595. proc Stta::checkKeywords {{newKeywordList ""} {quietly 0} {noPrefs 0}} {
  1596.     
  1597.     global SttamodeVars
  1598.     
  1599.     global SttaCommands  SttaUserCommands  SttaPrefixes    SttaParameters
  1600.     global SttaFunctions SttaOptions       SttaUserOptions SttaModifiers
  1601.     global SttaMacros    SttaDated
  1602.     
  1603.     set type 0
  1604.     if {$newKeywordList == ""} {
  1605.         set quietly 0
  1606.         set newKeywordList [prompt "Enter Stata mode keywords to be checked:" ""]
  1607.     }
  1608.     # Check to see if the new keyword(s) is already defined.
  1609.     foreach newKeyword $newKeywordList {
  1610.         if {[lsearch -exact $SttaCommands $newKeyword] != "-1"} {
  1611.             set type SttaCommands
  1612.         } elseif {[lsearch -exact $SttaUserCommands $newKeyword] != "-1"} {
  1613.             set type SttaUserCommands
  1614.         } elseif {[lsearch -exact $SttaPrefixes $newKeyword] != "-1"} {
  1615.             set type SttaPrefixes
  1616.         } elseif {[lsearch -exact $SttaParameters $newKeyword] != "-1"} {
  1617.             set type SttaParameters
  1618.         } elseif {[lsearch -exact $SttaFunctions $newKeyword] != "-1"} {
  1619.             set type SttaFunctions
  1620.         } elseif {[lsearch -exact $SttaOptions $newKeyword] != "-1"} {
  1621.             set type SttaOptions
  1622.         } elseif {[lsearch -exact $SttaUserOptions $newKeyword] != "-1"} {
  1623.             set type SttaUserOptions
  1624.         } elseif {[lsearch -exact $SttaModifiers $newKeyword] != "-1"} {
  1625.             set type SttaModifiers
  1626.         } elseif {[lsearch -exact $SttaMacros $newKeyword] != "-1"} {
  1627.             set type SttaMacros
  1628.         } elseif {[lsearch -exact $SttaDated $newKeyword] != "-1"} {
  1629.             set type SttaDated
  1630.         } elseif {!$noPrefs && \
  1631.           [lsearch -exact $SttamodeVars(addCommands) $newKeyword] != "-1"} {
  1632.             set type SttamodeVars(addCommands)
  1633.         } elseif {!$noPrefs && \
  1634.           [lsearch -exact $SttamodeVars(addOptions) $newKeyword] != "-1"} {
  1635.             set type SttamodeVars(addOptions)
  1636.         }
  1637.         if {$quietly} {
  1638.             # When this is called from other code, it should only contain
  1639.             # one keyword to be checked, and we'll return it's type.
  1640.             return "$type"
  1641.         } elseif {!$quietly && $type == 0} {
  1642.             alertnote "\"$newKeyword\" is not currently defined\
  1643.               as a Stta mode keyword."
  1644.         } elseif {$type != 0} {
  1645.             # This will work for any other value for "quietly", such as 2
  1646.             alertnote "\"$newKeyword\" is currently defined as a keyword\
  1647.               in the \"$type\" list."
  1648.         } 
  1649.         set type 0
  1650.     }
  1651. }
  1652.  
  1653. # ===========================================================================
  1654. # 
  1655. # ◊◊◊◊ Marks ◊◊◊◊ #
  1656. # 
  1657.  
  1658. proc Stta::markFileProc {menuName item} {
  1659.     
  1660.     if {$item == "source"} {
  1661.         Stta::MarkFile {.do}
  1662.     } elseif {$item == "output"} {
  1663.         # doesn't really matter what we put for the mark file "type" here,
  1664.         # since output is the default if other "if ..." cases aren't met.
  1665.         Stta::MarkFile {.out}
  1666.     } elseif {$item == "codebook"} {
  1667.         Stta::MarkFile {.codebook}
  1668.     } elseif {$item == "autoMark"} {
  1669.         Stta::flagFlip autoMark
  1670.         Stta::rebuildMenu markStataFileAs…
  1671.     }
  1672. }
  1673.  
  1674. # ===========================================================================
  1675. # 
  1676. # ◊◊◊◊ Processing ◊◊◊◊ #
  1677. # 
  1678.  
  1679. # ===========================================================================
  1680. # 
  1681. # Do FIle
  1682. # 
  1683. # Send entire file to Stata for processing, adding carriage return at end
  1684. # of file if necessary.  Note that unlike Stata's do-file editor, the name
  1685. # of the actual file appears in Stata's output window!
  1686. # 
  1687. # Optional "f" argument allows this to be called by other code, or to be 
  1688. # sent via a Tcl shell window.
  1689. # 
  1690.  
  1691. proc Stta::doFile {{f ""} {app "Stata"}} {
  1692.     
  1693.     if {$f != ""} {file::openAny $f}
  1694.     set f [win::Current]
  1695.  
  1696.     set dirtyWindow [winDirty]
  1697.     set dontSave 0
  1698.     if {$dirtyWindow && [askyesno \
  1699.       "Do you want to save the file before sending it to Stata?"] == "yes"} {
  1700.         save
  1701.     } else {
  1702.         set dontSave 1
  1703.     } 
  1704.     if {!$dontSave && [lookAt [pos::math [maxPos] - 1]] != "\r"} {
  1705.         set pos [getPos]
  1706.         goto [maxPos]
  1707.         insertText "\r"
  1708.         goto $pos
  1709.         alertnote "Carriage return added to end of file."
  1710.         save
  1711.     }
  1712.  
  1713.     app::launchBack '[Stta::sig]'
  1714.     sendOpenEvent noReply '[Stta::sig]' $f
  1715.     switchTo '[Stta::sig]'
  1716. }
  1717.  
  1718. # ===========================================================================
  1719. # 
  1720. # Do Selection
  1721. # 
  1722. # Procedure to implement transfer of selected lines to Stata for processing.
  1723. # 
  1724.  
  1725. proc Stta::doSelection {{selection ""} {app "Stata"}} {
  1726.     
  1727.     global PREFS
  1728.     
  1729.     if {$selection == ""} {
  1730.         if {![isSelection]} {
  1731.             message "No selection -- cancelled."
  1732.             return
  1733.         } else {
  1734.             set selection [getSelect]
  1735.         } 
  1736.     }
  1737.     file::ensureDirExists [file join $PREFS Stata-tmp]
  1738.     set newFile [file join $PREFS Stata-tmp temp-Stata.do]
  1739.     file::writeAll $newFile $selection 1
  1740.  
  1741.     app::launchBack '[Stta::sig]'
  1742.     sendOpenEvent noReply '[Stta::sig]' $newFile
  1743.     switchTo '[Stta::sig]'
  1744. }
  1745.  
  1746. proc Stta::quitHook {} {temp::cleanup Stata-tmp}
  1747.  
  1748. # ===========================================================================
  1749. # 
  1750. # ◊◊◊◊ Insertions ◊◊◊◊ #
  1751. # 
  1752.  
  1753. proc Stta::insertPath {} {
  1754.     
  1755.     global file::separator
  1756.     
  1757.     set path ""
  1758.     set t    ""
  1759.     append t "\"${file::separator}"
  1760.     set path [getfile "Choose path of target file:"]
  1761.     if {$path != ""} {
  1762.         append t $path
  1763.         append t "\""
  1764.         typeText $t
  1765.     }
  1766. }
  1767.  
  1768. # An example of Stata specific electric insertion templates that could be
  1769. # added to the menu.
  1770.  
  1771. proc Stta::programTemplate {} {
  1772.  
  1773.     global SttamodeVars
  1774.     
  1775.     set end [lindex [Stta::getCommand [getPos]] 1]
  1776.     if {$end != "-1" && $end > [getPos]} {
  1777.         goto $end
  1778.     }
  1779.     if {$SttamodeVars(semiDelimiter)} {
  1780.         set eol " ;\r"
  1781.     } else {
  1782.         set eol "\r"
  1783.     } 
  1784.     
  1785.     set    pt "program define •progname•${eol}\tversion 6.0${eol}\tif \"`1'\""
  1786.     append pt " == \"?\" {\r\t\tglobal S_1 \"•variable names•\"${eol}\t\t"
  1787.     append pt "exit${eol}\t}${eol}\t••\r\t* (each result below must correspond"
  1788.     append pt " to a variable in S_1)${eol}\tpost `1' •results•${eol}end${eol}"
  1789.     elec::Insertion $pt
  1790. }
  1791.  
  1792. # ===========================================================================
  1793. # 
  1794. # ◊◊◊◊ Navigation ◊◊◊◊ #
  1795. # 
  1796.  
  1797. # Next/Prev command can simply return the position of the next command
  1798. # (quietly == 1), move the cursor to the next command (placing the cursor
  1799. # at the top of the window if toTop == 1), extend the current selection to
  1800. # the end of the this command, or (if the current command is already
  1801. # highlighted in its entirety) extend the current selection to the end of
  1802. # the next command.
  1803. # 
  1804.  
  1805. proc Stta::nextCommand {{quietly 0} {toTop 0}} {
  1806.     
  1807.     if {[pos::compare [selEnd] == [maxPos]]} {
  1808.         set pos [maxPos]
  1809.     } else {
  1810.         set pos [pos::math [selEnd] + 1]
  1811.     } 
  1812.     set pat {^[^\r\n\t \*/]}
  1813.  
  1814.     if {![catch {search -f 1 -r 1 $pat $pos} match]} {
  1815.         set pos [lineStart [lindex $match 1]]
  1816.     } else {
  1817.         set pos [maxPos]
  1818.     }
  1819.     if {$quietly} {
  1820.         return $pos
  1821.     } elseif {[isSelection]} {
  1822.     set limit1 [lindex [Stta::getCommand [selEnd]] 1]
  1823.     set limit2 [lindex [Stta::getCommand $pos    ] 1]
  1824.     if {$limit2 == "-1"} {set limit2 [maxPos]}
  1825.     if {$limit1 == "-1"} {set limit1 $limit2}
  1826.     if {[pos::compare [selEnd] < $limit1]} {
  1827.         select [getPos] $limit1
  1828.     } else {
  1829.         select [getPos] $limit2
  1830.     } 
  1831.     } elseif {$pos == [maxPos]} {
  1832.     message "No further commands in the file."
  1833.     return
  1834.     } else {
  1835.     goto $pos
  1836.     message [getText $pos [nextLineStart $pos]]
  1837.     } 
  1838.     if {$toTop} {insertToTop}
  1839. }
  1840.  
  1841. proc Stta::prevCommand {{quietly 0} {toTop 0}} {
  1842.     
  1843.     if {[pos::compare [getPos] == [minPos]]} {
  1844.         set pos [minPos]
  1845.     } else {
  1846.         set pos [pos::math [getPos] - 1]
  1847.     } 
  1848.     set pat {^[^\r\n\t \*/]}
  1849.  
  1850.     if {![catch {search -f 0 -r 1 $pat $pos} match]} {
  1851.         set pos [lineStart [lindex $match 1]]
  1852.     } else {
  1853.         set pos [minPos]
  1854.     }
  1855.     if {$quietly} {
  1856.     return $pos
  1857.     } elseif {[isSelection]} {
  1858.     # Going backwards is actually easier with selections.
  1859.     select $pos [selEnd]
  1860.     } elseif {$pos == [minPos]} {
  1861.     message "No further commands in the file."
  1862.     return
  1863.     } else {
  1864.     goto $pos
  1865.     message [getText $pos [nextLineStart $pos]]
  1866.     } 
  1867.     if {$toTop} {insertToTop}
  1868.     return $pos
  1869. }
  1870.  
  1871. proc Stta::searchFunc {direction} {
  1872.     
  1873.     if {$direction} {
  1874.         Stta::nextCommand
  1875.     } else {
  1876.         Stta::prevCommand
  1877.     }
  1878. }
  1879.  
  1880. proc Stta::selectCommand {} {
  1881.     
  1882.     set pos    [getPos]
  1883.     set limits [Stta::getCommand $pos]
  1884.     set posBeg [lindex $limits 0]
  1885.     set posEnd [lindex $limits 1]
  1886.     set test1  [pos::compare $pos >= $posBeg]
  1887.     set test2  [pos::compare $pos <= $posEnd]
  1888.     if {$posBeg != "-1" && $test1 && $test2} {
  1889.         select $posBeg $posEnd
  1890.     } else {
  1891.         message "The cursor is not within a command."
  1892.         error "The cursor is not within a command."
  1893.     } 
  1894. }
  1895.  
  1896. proc Stta::copyCommand {{quietly 0}} {
  1897.     
  1898.     set pos [getPos]
  1899.     if {[set posBeg [lindex [Stta::getCommand $pos] 0]] != "-1"} {
  1900.         goto $posBeg
  1901.         forwardWord
  1902.         set posEnd [getPos]
  1903.         if {!$quietly} {
  1904.             select $posBeg $posEnd
  1905.             copy
  1906.             message "\"[getText $posBeg $posEnd]\" copied to clipboard."
  1907.         } 
  1908.         goto $pos
  1909.         return [getText $posBeg $posEnd]
  1910.     } elseif {!$quietly} {
  1911.         message "The cursor is not within a command."
  1912.     }
  1913.     return ""
  1914. }
  1915.  
  1916. proc Stta::reformatCommand {} {
  1917.     
  1918.     if {![isSelection]} {Stta::selectCommand} 
  1919.     message "Reformatting …"
  1920.     ::indentRegion
  1921.     goto [pos::math [getPos] -1]
  1922.     goto [Stta::nextCommand 1]
  1923.     message "Reformatted."
  1924. }
  1925.  
  1926. proc Stta::getCommand {pos} {
  1927.     
  1928.     set pos1 [pos::math [nextLineStart $pos] - 1]
  1929.     set pat {^[^\r\n\t \}\)]}
  1930.     set posBeg "-1"
  1931.     set posEnd "-1"
  1932.     if {![catch {search -f 0 -r 1 $pat $pos1} match]} {
  1933.         set posBeg [lindex $match 0]
  1934.         set pos2   [nextLineStart $posBeg]
  1935.         if {![catch {search -f 1 -r 1 $pat $pos2} match]} {
  1936.             set posEnd [lindex $match 0]
  1937.         } else {
  1938.             set posEnd [maxPos]
  1939.         } 
  1940.         # Now back up to remove empty or commented lines.
  1941.         set posEndPrev [pos::math $posEnd - 1]
  1942.         set prevLine [getText [lineStart $posEndPrev] $posEndPrev]
  1943.         while {[regexp {^[\t ]*$} $prevLine]} {
  1944.             set posEnd [lineStart $posEndPrev]
  1945.             set posEndPrev [pos::math $posEnd - 1]
  1946.             set prevLine [getText [lineStart $posEndPrev] $posEndPrev]
  1947.         }
  1948.     } 
  1949.     return [list $posBeg $posEnd]
  1950. }
  1951.  
  1952. # ===========================================================================
  1953. # 
  1954. # ◊◊◊◊ --------------------- ◊◊◊◊ #
  1955. # 
  1956. # ◊◊◊◊ version history ◊◊◊◊ #
  1957. # 
  1958. #  modified by  vers#  reason
  1959. #  -------- --- ------ -----------
  1960. #  01/28/20 cbu 1.0.1  First created Stata mode, based upon other modes found 
  1961. #                        in Alpha's distribution.  Commands are based on 
  1962. #                        release version 3.1 of Stata.
  1963. #  03/02/20 cbu 1.0.2  Minor modifications to comment handling.
  1964. #  03/20/00 cbu 1.0.3  Minor update of keywords dictionaries. 
  1965. #                      Renamed mode Stta, from stta 
  1966. #  04/01/00 cbu 1.0.4  Added new preferences to allow the user to enter 
  1967. #                        additional commands and options.  
  1968. #                      Reduced the number of different user-specified colors.
  1969. #                      Added "Stta::updateColors" to avoid need for a restart.
  1970. #  04/08/00 cbu 1.0.5  Unset obsolete preferences from earlier versions.
  1971. #                      Modified "Stta::electricSemi", added key-bindings for
  1972. #                        "Continue Comment", and "Electric Return Over-ride".
  1973. #                      Renamed "Stta::updateColors" to "Stta::updatePreferences".
  1974. #  04/16/00 cbu 1.1    Renamed to stataMode.tcl
  1975. #                      Added "Stta::MarkFile" and "Stta::parseFuncs".
  1976. #                      Added command double-click for on-line help.
  1977. #  06/20/00 cbu 1.2    "Mark File" now recognizes headings as well as commands.
  1978. #                      "Mark File" recognizes source, output, or codebook files.
  1979. #                      Completions, Completions Tutorial added.
  1980. #                      "Reload Completions", referenced by "Update Preferences".
  1981. #                      Better support for user defined keywords.
  1982. #                      Removed "Continue Comment", now global in Alpha 7.4.
  1983. #                      <shift, control>-<command> double-click syntax info.
  1984. #           lps        <option>-<command> double-click Stata app .hlp help.
  1985. #           lps        Added Phil Schumm's Stata Menu.
  1986. #           lps        Added "Continue Command" key binding and proc.
  1987. #                      Added "localHelpOnly" variable for command double-click.
  1988. #  08/23/00 cbu 1.2.1  "Mark File As" added to Stata menu.  (Required adding
  1989. #                        an optional argument to Stta::MarkFile, reworking
  1990. #                        of the stata menu build procs.)
  1991. #                      "Help" added to Stata menu.  (Required splitting off
  1992. #                        "wwwCommandHelp" and "localCommandHelp" from
  1993. #                        command double-click, giving them optional arguments.
  1994. #                      Gave "doFile" an optional argument, so that it could
  1995. #                        be called from other code, or a shell.
  1996. #                      DblClick now looks for macro definitions in current file.
  1997. #                      "localHelpOnly" preference changed to "localHelp"
  1998. #                      Changing "localHelp" changes Stata Help menu bindings.
  1999. #                      Small fixes to SttaCompletions.tcl.
  2000. #                      Removed "codebookSuffix" preference, now that the 
  2001. #                        menu has "Mark File As…".
  2002. #                      Added "stataSig" preference to allow user to find
  2003. #                        local application if necessary.
  2004. #                      Added "Stta::sig" which returns Stata signature.
  2005. #  08/28/00 cbu 1.2.2  Added some of the flag preferences to "Stata Help" menu.
  2006. #                      Added "Stta::flagFlip" to change bullets in menu.
  2007. #                      Added a "noHelpKey" preference, which switches the
  2008. #                        "help" key binding to F8.
  2009. #                      Added "addNewCommands/Options" to "Stata Help" menu.
  2010. #                      Added "setStataApplication to "Stata Help" menu.
  2011. #  11/05/00 cbu 1.3    Added "next/prevCommand", "selectCommand", and
  2012. #                        "copyCommand" procs to menu.
  2013. #                      Added "continueComment" to menu.
  2014. #                      Added "Stta::indentLine".
  2015. #                      Added "reformatCommand" to menu.
  2016. #                      Modified "Stta::continueCommand" to take advantage of
  2017. #                        automatic indentation using Stta::indentLine.
  2018. #                      Modified Stta::programTemplate to take semi delimiter
  2019. #                        into account, and to not insert within a command.
  2020. #                      "Stta::reloadCompletions" is now obsolete.
  2021. #                      "Stta::updatePreferences" is now obsolete.
  2022. #                      "Stta::colorizeStta" now takes care of setting all 
  2023. #                        keyword lists, including Sttacmds.
  2024. #                      Cleaned up completion procs.  This file never has to be
  2025. #                        reloaded.  (Similar cleaning up for "Stta::DblClick").
  2026. #  11/16/00 cbu 2.0    New url prefs handling requires 7.4b21
  2027. #                      Added "Home Page" pref, menu item.
  2028. #                      Removed  hook::register requireOpenWindowsHook from
  2029. #                        mode declaration, put it after menu build.
  2030. #  12/19/00 cbu 2.1    The menu proc "Add Commands" now includes an option
  2031. #                        to grab all of the "extra" command from the current
  2032. #                        window, using Stta::addWindowCommands.
  2033. #                      Added "Keywords" submenu, "List Keywords" menu item.
  2034. #                      Big cleanup of ::sig, ::setApplication, processing ...
  2035. #  01/25/01 cbu 2.1.1  Bug fix for Stta::doSelection.
  2036. #                      Bug fix for comment characters.
  2037. #                      Better codebook marking.
  2038. #                      Added Stta::commandHelp for help file hyperlinks.
  2039. # 
  2040.  
  2041. # ===========================================================================
  2042. # 
  2043. # .
  2044.